Show the code
pacman::p_load(ggiraph, plotly, patchwork, hrbrthemes, ggthemes, readxl,
tmap, ggstatsplot, heatmaply, kableExtra, rmarkdown,
RColorBrewer, tidyverse, crosstalk, htmltools, sf)Uncover the salient patterns of Singapore public housing resale prices with R
Law Shiang Rou
Feb 5, 2023

In take-home exercise 3, various interactive visualizations are prepared using R packages and functions such as ggiraph, ggplot2, and ggstatsplot to showcase the salient patterns of the Singapore public housing resale prices in 2022. The focus of this exercise is on 4-room and 5-room public houses (HDB flats).
The main dataset used is obtained from data.gov.sg. Additional information on region, town maturity and distance to mrt are also added to provide more insights to viewers.
Some required libraries include:
The original data is available in csv format. Read_csv function is being used here to read the data. Below shows a snippet of the dataset.
For the purpose of this exercise, the data on year 2022 for 3-room and 4-room resale flats is filtered.
Additional data on region, town maturity and distance to mrt is imported into R Studio.
The additional information on region, town maturity and distance to nearest mrt are joined to the main dataset.
In order to perform further analysis, the resale price per sqm is computed by dividing resale_price by floor_area_sqm.
Remaining lease in year is also calculated by taking the substring of the remaining_lease column.
The original storey_range field contains too many categories, making it difficult to analyse. Hence, we re-categorize storey_range into 4 categories.
In this section, exploratory data analysis is performed using various visualization methods to uncover patterns of the HDB resale market in Singapore and identify the differences between the various flat types and towns.
This section aims to provide viewers with a basic overview on Singapore 3-room and 4-room HDB resale flats market by visualizing the number of transactions and overall resale prices in 2022.
The 2 interactive charts are designed to showcase the overall number of resale transactions in 2022 and the resale price range for both 3-room and 4-room flats across Singapore. Through the visuals, viewers can also identify the differences between the resale market for 3-room vs 4-room flats.
# Boxplot displaying the statistic summary of resale prices for 3-room and 4-room HDB.
# specifying ybreaks and ylables
ybrks <- seq(200000, 1500000, 100000)
ylabls <- paste0(as.character(c(seq(200, 1500, 100))),"k")
# customizing the appearance of tooltips
tooltip_css <- "background-color:white;padding:8px;border-radius:10px 10px 10px 10px;
font-style:bold; color:black;"
# Calculating the stats for tooltips
stats <- hdb_data_all %>%
group_by(flat_type) %>%
summarise(
Min = prettyNum(min(resale_price),
big.mark = ",", scientific = FALSE),
Q1 = prettyNum(quantile(resale_price, 0.25),
big.mark = ",", scientific = FALSE),
Median = prettyNum(median(resale_price),
big.mark = ",", scientific = FALSE),
Mean = prettyNum(mean(resale_price),
big.mark = ",", scientific = FALSE),
Q3 = prettyNum(quantile(resale_price, 0.75),
big.mark = ",", scientific = FALSE),
Max = prettyNum(max(resale_price),
big.mark = ",", scientific = FALSE))
# Placing the stats into a table
tooltip_table <- data.frame(unclass(stats), check.names = FALSE) %>%
kableExtra::kable(align = "c", booktabs=TRUE, row.names=FALSE,
col.names = c("Flat Type", "Min", "Q1",
"Median", "Mean", "Q3", "Max")) %>%
row_spec(0, color = "white", background = "black")%>%
kable_styling(font_size = 11,bootstrap_options = "bordered")
# Plotting the boxplot
p1 <- ggplot(data = hdb_data_all,
aes(x=flat_type, y=resale_price, fill = flat_type)) +
geom_boxplot_interactive(aes(tooltip=tooltip_table,
data_id=flat_type)) +
stat_summary(fun.y=mean, geom="point", shape = 15, color="white")+
theme_linedraw() + xlab("Flat Type") +
scale_y_continuous(name = "Resale \nPrice",
breaks=ybrks, labels=ylabls) +
ggtitle("Resale Prices by Flat Type")+
theme(axis.title.y = element_text(angle=0),
axis.ticks.x = element_blank(),
panel.grid.minor.y = element_line(colour="grey85",
linetype = "dotted"),
panel.grid.major.x = element_blank(),
plot.title = element_text(size=10, face = "bold",hjust=0.5),
axis.title = element_text(size =9),
legend.position = "none")# Bar chart showing the number of transactions for each flat type
# Computing the count
lab <- hdb_data_all %>% group_by (flat_type) %>% tally()
# Plotting the bar chart
p2 <- ggplot(lab,aes(x=flat_type, y=n, fill=flat_type))+
geom_bar_interactive(stat="identity", aes(data_id=flat_type, tooltip=paste(
"Number of Transactions =",format(n,big.mark = ",", scientific = FALSE))))+
geom_text(aes(label=n),vjust=1.3, color = "white")+
theme_linedraw() + xlab("Flat Type") +
scale_y_continuous(name = "No. of\nTransactions") +
ggtitle("Number of Resale Transactions by Flat Type")+
theme(axis.title.y = element_text(angle=0, hjust=1),
axis.ticks.x = element_blank(),
panel.grid.minor.y = element_line(colour = "grey85", linetype = "dotted"),
panel.grid.major.x = element_blank(),
plot.title = element_text(size=10, face = "bold", hjust=0.5),
axis.title = element_text(size =9),
legend.position = "none")
# Making the charts interactive with coordinating views
girafe(
code = print((p1+p2)+
plot_annotation(
title="Overview of HDB Resale Market, Singapore 2022",
subtitle = "Comparison between 3-room and 4-room HDB",
caption="Data on 2022 Singapore resale prices from Data.gov.sg",
theme = theme(plot.title = element_text(face = "bold", size = 13),
plot.caption = element_text(face = "italic", size=7))
)),
width_svg = 8,
height_svg = 8*0.618,
options = list(
opts_hover_inv(css = "opacity:0.2;"),
opts_hover(css = "none"),
opts_tooltip(css = tooltip_css)
)
)In 2022,
This visualization showcases the resale prices and number of transactions by town for each flat type. It helps viewers understand the differences between town.
The 2 charts are interactive and coordinated. Each town is represented by a point and viewers can hover over each point to view the mean resale price and total number of resale transactions in 2022 in the specific town.
# As the number of towns in dataset exceed the number of colors in palatte,
# colorRampPalette is used to generate more colors.
colourCount = length(unique(hdb_data_all$town))
getPalette = colorRampPalette(brewer.pal(12, "Paired"))
# Preparing the data for scatter plot
scatter_data <- hdb_data_all %>%
group_by(town, flat_type) %>%
summarise(mean_price = round(mean(resale_price),1), trsn_number = n())
# Specifying the break and label for yaxis
ybrks1 <- seq(200000, 1000000, 100000)
ylabls1 <- paste0(as.character(c(seq(200, 1000, 100))),"k")
# Plotting the scatter plot
scatter <- ggplot(scatter_data, aes(x=trsn_number, y=mean_price)) +
geom_point_interactive(alpha = 0.7, aes(colour=factor(town), size = 5, data_id=town,
tooltip=paste(town,"\nNo. of Transactions: ",
format(trsn_number,big.mark = ",", scientific = FALSE),
"\nMean Resale Price: ",
format(mean_price,big.mark = ",", scientific = FALSE)))) +
scale_colour_manual(values = getPalette(colourCount)) +
geom_smooth_interactive(method=lm, se=FALSE, col='lightblue',
aes(tooltip="fitted line", data_id="smooth")) +
theme_linedraw() +
xlab("Number of Transactions")+
labs(caption="Data on 2022 Singapore resale prices from Data.gov.sg")+
scale_y_continuous(name = "Mean\nResale Price",
breaks=ybrks1, labels=ylabls1) +
ggtitle("Mean Resale Price vs Number of Resale Transactions by Flat Type, Singapore 2022") +
theme(axis.title.y = element_text(angle=0),
panel.grid.major.y = element_line(colour="black",
linetype = "dotted"),
panel.grid.major.x = element_line(colour="black",
linetype = "dotted"),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
plot.title = element_text(size=11, hjust=0.5, face = "bold"),
plot.caption = element_text(face = "italic", size=7),
axis.title = element_text(size =9),
legend.position = "none") +
# Use facet_wrap to split 3-room and 4-room into 2 plots
facet_wrap(~flat_type, ncol = 2)
# Making the plot interactive using girafe
girafe(
ggobj=scatter,
width_svg = 9,
height_svg = 7*0.618,
options = list(
opts_hover_inv(css = "opacity:0.1;"),
opts_hover(css = "none"),
opts_tooltip(css = tooltip_css)
)
)Unlike the previous visualization where only the average resale prices for each town are shown, this section allows viewers to gain more insights based on the distribution of resale prices in each town.
# Plotting number of transactions by flat type and town
group1<- hdb_data_all %>% group_by (town, flat_type) %>% tally()
colourCount = length(unique(hdb_data_all$town))
getPalette = colorRampPalette(brewer.pal(12, "Paired"))
p4 <- group1 %>%
mutate(town = fct_reorder(town, n, .fun='mean')) %>%
ggplot(aes(x=reorder(town, n), y=n, fill=factor(town))) +
scale_fill_manual(values = getPalette(colourCount)) +
geom_bar_interactive(stat="identity", aes(data_id=town, tooltip=paste("Town: ",town,
"\nNumber of Transactions: ",format(n,big.mark = ",", scientific = FALSE))))+
xlab("Towns") +
theme_linedraw() +
scale_y_continuous(name = "Number of \nTransactions") +
xlab("Town")+
theme(axis.title.y = element_text(angle=0),
axis.ticks.x = element_blank(),
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1),
panel.grid.minor.y = element_line(colour = "grey85", linetype = "dotted"),
panel.grid.major.x = element_blank(),
plot.title = element_text(size=12, hjust = 0.5),
axis.title = element_text(size =9),
legend.position = "none") +
facet_wrap(~flat_type, ncol = 1)# plotting boxplot of resale price by flat type and town
p3 <- ggplot(data = hdb_data_all,
aes(x=reorder(town, resale_price), y=resale_price, fill = town)) +
geom_boxplot_interactive(aes(tooltip=after_stat({
paste0("Min: ", prettyNum(.data$ymin,big.mark = ",", scientific = FALSE),
"\nMax: ", prettyNum(.data$ymax,big.mark = ",", scientific = FALSE),
"\nMedian: ", prettyNum(.data$middle,big.mark = ",", scientific = FALSE)
)
}),
data_id=town)) +
scale_fill_manual(values = getPalette(colourCount)) +
stat_summary(fun.y=mean, geom="point", shape = 3, color="white")+
theme_linedraw() +
scale_y_continuous(name = "Resale \nPrice",
breaks=ybrks, labels=ylabls) +
xlab("Town")+
theme(axis.title.y = element_text(angle=0),
axis.ticks.x = element_blank(),
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1),
panel.grid.minor.y = element_line(colour="grey85",
linetype = "dotted"),
panel.grid.major.x = element_blank(),
plot.title = element_text(size=12, hjust=0.5),
axis.title = element_text(size =9),
legend.position = "none") +
facet_wrap(~flat_type,ncol = 1)
# Putting the 2 charts together and have a coordinated view
girafe(
code = print((p4+p3) + plot_annotation(
title = 'Number of Resale Transactions & Resale Prices by Flat Type & Towns, Singapore 2022',
subtitle = "Ordered by transaction count and mean resale price",
caption = "Data on 2022 Singapore HDB resale prices from Data.gov.sg",
theme = theme(plot.title = element_text(face = "bold", size = 15),
plot.caption = element_text(face = "italic", size=7)))),
width_svg = 10,
height_svg = 11*0.618,
options = list(
opts_hover_inv(css = "opacity:0.2;"),
opts_hover(css = "none"),
opts_tooltip(css = tooltip_css))
)Considering that not all viewers are familiar with the geographical location of each town in Singapore, a choropleth map is prepared to show where each town is located at.
Reading layer `MP14_SUBZONE_WEB_PL' from data source
`D:\shiangrou\ISSS608-VAA\Take_Home_Exercise\Take_Home_Exercise_3\master-plan-2014-subzone-boundary-web-shp'
using driver `ESRI Shapefile'
Simple feature collection with 323 features and 15 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: 2667.538 ymin: 15748.72 xmax: 56396.44 ymax: 50256.33
Projected CRS: SVY21 / Singapore TM
# Preparing the choropleth map
mpsz_price <- left_join(singapore, mean_prices, by = c("PLN_AREA_N" = "town"))
tmap_mode("view")
tm_shape(mpsz_price)+
tmap_options(check.and.fix = TRUE)+
tm_fill("Mean Resale Price Per Sqm", id=paste("PLN_AREA_N"),
n = 6,
style = "pretty",
palette = "Greens") +
tm_borders(alpha = 0.7)In this section, correlation analysis is performed to find out the correlation between resale prices and other variables. Then, hypothesis testing is done to evaluate our hypotheses and produce statistical inferences.
With correlation analysis, we aim to answer 2 questions:
Through this analysis, viewers can identify the correlated variables. However, do be mindful that correlation does not imply causation.
# Selecting all the numeric factors
hdb_numeric <- hdb_data_all1 %>%
select(flat_type, resale_price, storey_low, floor_area_sqm,
nearest_distance_to_mrt, remaining_lease_year) %>%
rename("Resale Price" = resale_price, "Storey"=storey_low,
"Floor Area"=floor_area_sqm,
"Distance to nearest MRT/LRT"=nearest_distance_to_mrt,
"Remaining Lease (Year)"=remaining_lease_year)
hdb_numeric$Storey <- as.numeric(hdb_numeric$Storey)
# Plotting the correlation matrix
grouped_ggcorrmat(
data = hdb_numeric,
grouping.var = flat_type,
hc.order = TRUE,
matrix.type = "lower",
output="plot",
plotgrid.args = list(ncol = 2),
ggcorrplot.args = list(outline.color = "black",
lab_col = "navy",
lab_size = 3.2,
pch.col = "red",
pch.cex = 1),
annotation.args = list(tag_levels = "i",
title = "Pairwise Correlation of Numeric Variables",
subtitle = "Resale price most highly correlated with remaining lease and storey",
caption = "Data on 2022 Singapore resale prices from Data.gov.sg"),
ggplot.component = list(theme_void(base_size = 8),
theme(plot.title = element_text(size=12),
plot.subtitle = element_text(size=7),
plot.caption = element_text(size=2),
legend.text = element_text(size=7),
axis.text.x = element_text(size = 8, angle = 90, vjust = 0.5,hjust = 0.9),
axis.text.y = element_text(size = 8, hjust = 1),
strip.text.x = element_text(size = 7),
legend.key.size = unit(3, 'mm')
))
)
From 4.1, we saw that resale prices are most highly correlated with remaining lease and storey, hence, we want to find out how sensitive the resale prices is to remaining lease and storey in each town.
# Creating the dataset required for heatmap
hdb_by_lease<- hdb_data_all %>%
group_by(town, flat_type, remaining_lease_year) %>%
summarise(Mean_price_per_sqm = median(price_sqm))
# group the remaining lease into 7 groups
hdb_by_lease <- hdb_by_lease %>%
mutate(lease_cat =
cut(remaining_lease_year,
breaks = c(0,39,49,59,69,79,89,99),
labels = c("<40 years","40-49 years","50-59 years","61-69 years","70-79 years", "80-89 years", "90-99 years")))
# plotting the heatmap for remaining lease
heatmap1 <- ggplot(data = hdb_by_lease,
mapping = aes(x = town, y = lease_cat,fill = Mean_price_per_sqm)) +
geom_tile_interactive(stat="identity",
aes(data_id=town,tooltip=paste(town,"\n",lease_cat,"\nMean Price Per Sqm: ",
prettyNum(round(Mean_price_per_sqm,0),
big.mark = ",", scientific = FALSE)))) +
labs(title = "Heatmap showing resale price/sqm by remaining lease and storey", y = "Remaining \nLease") +
scale_fill_distiller(name = "Mean Resale Price per Sqm", palette = "Purples",direction=1)+
theme_linedraw() +
theme(axis.title.y = element_text(angle=0),
axis.title.x = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.text.x = element_text(size = 6, angle = 90, vjust = 0.5, hjust=1),
axis.text.y = element_text(size = 6),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_blank(),
plot.title = element_text(size=12, hjust=0.5),
axis.title = element_text(size =9),
legend.key.height= unit(0.5, 'cm'),
legend.key.width= unit(1.8, 'cm'),
legend.title = element_text(size=8),
legend.text = element_text(size=6),
legend.position = "top") +
facet_wrap(~flat_type)# Creating the dataset required for heatmap
hdb_by_storey<- hdb_data_all %>%
group_by(town, flat_type, storey_range) %>%
summarise(Mean_price_per_sqm = median(price_sqm))
# plotting the heatmap for storey
heatmap2 <- ggplot(data = hdb_by_storey,
mapping = aes(x = town, y = storey_range,fill = Mean_price_per_sqm)) +
geom_tile_interactive(stat="identity", aes(data_id=town,tooltip=paste(town,"\n",storey_range,"\nMean Price Per Sqm: ",prettyNum(round(Mean_price_per_sqm,0), big.mark = ",", scientific = FALSE))))+
labs(caption = "Data on 2022 Singapore resale prices from Data.gov.sg", x = "Town", y = "Storey") +
scale_fill_distiller(name = "Mean Resale Price per Sqm", palette = "YlGn", direction=1)+
theme_linedraw() +
theme(axis.title.y = element_text(angle=0),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.text.x = element_text(size = 6, angle = 90, vjust = 0.5, hjust=1),
axis.text.y = element_text(size = 6),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_blank(),
plot.title = element_text(size=12, hjust=0.5, face="bold"),
plot.caption = element_text(size=7, face = "italic"),
axis.title = element_text(size =9),
legend.key.height= unit(0.5, 'cm'),
legend.key.width= unit(1.8, 'cm'),
legend.title = element_text(size=8),
legend.text = element_text(size=6),
legend.position = "top") +
facet_wrap(~flat_type)
# Putting the 2 heatmap together and have a coordinated view
girafe(
code = print(heatmap1/heatmap2),
width_svg = 6,
height_svg = 12*0.618,
options = list(
opts_hover_inv(css = "opacity:0.05;"),
opts_hover(css = "none"),
opts_tooltip(css = tooltip_css)
)
)In the previous sections, we observed that resale prices seem to vary across towns. Hence, we form our hypotheses and perform hypothesis tests to find out if the means between groups are significantly different.
First set of hypotheses:
H0 : The mean resale prices are equal across 5 regions. H1 : The mean resale prices are not equal across 5 regions.
Second set of hypotheses:
H0 : The mean resale prices are equal between mature and non-mature towns. H1 : The mean resale prices are not equal between mature and non-mature towns.
# plot mean prices by region
s1 <- grouped_ggbetweenstats(
data = hdb_data_all,
x = Region,
y = price_sqm,
grouping.var = flat_type,
xlab = "Region",
ylab = "Mean Resale Price",
type = "np",
pairwise.comparisons = TRUE,
pairwise.display = "non-significant",
k =2,
messages = FALSE,
plotgrid.args = list(nrow = 1),
ggtheme = ggplot2::theme_bw(),
annotation.args = list(title = "Mean Resale Price across Regions, Singapore 2022",
subtitle = "Only 2 pairs under 3-Room are not statistically significant"),) +
scale_fill_manual(values = getPalette(colourCount))# plot mean prices by town maturity
s2 <- grouped_ggbetweenstats(
data = hdb_data_all,
x = Maturity,
y = price_sqm,
grouping.var = flat_type,
xlab = "Town Maturity",
ylab = "Mean Resale Price",
type = "np",
pairwise.comparisons = TRUE,
pairwise.display = "all",
k =2,
messages = FALSE,
plotgrid.args = list(nrow = 1),
ggtheme = ggplot2::theme_bw(),
annotation.args = list(title = "Mean Resale Price by Town Maturity, Singapore 2022",
subtitle = "The pairs are statistically significant")) +
scale_fill_manual(values = getPalette(colourCount))# Putting the 2 charts together using patchwork
s1/s2 + plot_annotation(
title = 'Confirmatory Analysis: Testing the differences in mean resale prices across groups, 2022',
subtitle = "Tests for different regions and town maturity",
caption = "Data on 2022 Singapore resale prices from Data.gov.sg",
theme = theme(plot.title = element_text(face = "bold", size = 15),
plot.subtitle = element_text(size=12),
plot.caption = element_text(face = "italic", size = 7))
)
With the insights and inferences obtained from section 3 & 4, two visualization tools are designed for viewers to gain insights quickly and make clear and well-informed decision when selecting a resale flat based on their budgets and preferences.
In this section, a bubble plot is designed for viewers to easily view the average resale prices in each towns, against the key characteristics of the flats. This could help viewers to effectively shortlist the suitable towns for their resale flats.
# Computing the required fields for bubble plot
bubble_data <- hdb_data_all1 %>%
group_by(town, flat_type, storey) %>%
summarise(mean_price_per_sqm = mean(price_sqm), mean_lease = mean(remaining_lease_year)) %>%
arrange(desc(mean_lease))
# Plotting the bubble plot
bubble <- ggplot(bubble_data, aes(x=mean_lease, y=mean_price_per_sqm, size=mean_price_per_sqm, fill= storey)) +
geom_point_interactive(aes(data_id=town, tooltip=paste(town,"\n",storey,"floor\nMean Price/sqm: ",
prettyNum(round(mean_price_per_sqm,0),big.mark=","))),
alpha = 0.5, shape=21, color="black") +
scale_size(range=c(.1,18),name="Mean Price per Sqm") +
theme_linedraw() +
ylab("Avg. Price \nper Sqm") +
xlab("Avg. Lease Remaining")+
theme(axis.title.y = element_text(angle=0),
panel.grid.major.y = element_line(colour="black",
linetype = "dotted"),
panel.grid.major.x = element_line(colour="black",
linetype = "dotted"),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
plot.title = element_text(size=12, hjust=0.5),
axis.title = element_text(size =9),
legend.title = element_text(size=8),
legend.text = element_text(size=8),
legend.position = "right") +
scale_fill_viridis(discrete=TRUE, option="D") +
facet_wrap(~flat_type)
# Making the bubble plot interactive with girafe
girafe(
ggobj=bubble + plot_annotation(
title = 'Interactive Bubble Plot for Town Selection',
subtitle = "Avg. Reasle Price vs Avg. Lease Remaining for Each Town",
caption = "Data on 2022 Singapore HDB resale prices from Data.gov.sg",
theme = theme(plot.title = element_text(face = "bold", size = 15),
plot.caption = element_text(face = "italic", size=7))),
width_svg = 8,
height_svg = 8*0.618,
options = list(
opts_hover_inv(css = "opacity:0.1;"),
opts_hover(css = "none"),
opts_tooltip(css = tooltip_css)
)
)Viewers who have specific preferences in mind for their resale flats can use this tool to help them shortlist the specific HDB blocks or addresses that fit their criteria. This tool is also suitable for viewers who would like to see more details about each resale transaction.
# Extract the required columns
selected_col <- hdb_data_all1 %>%
select(Region, town, address, resale_price, flat_type, storey_range, storey,
floor_area_sqm, flat_model, lease_commence_date, remaining_lease,
nearest_mrt, nearest_distance_to_mrt)
# Building interactive filters
d <- highlight_key(selected_col)
filter_tools <- htmltools::div(
filter_select("town", "Town", d, ~town),
filter_checkbox("flat_type", "Flat Type", d, ~flat_type, inline = TRUE),
filter_slider("lease_commence_date", "Lease Commence Year", d, ~lease_commence_date),
filter_slider("nearest_distance_to_mrt", "Distance to Nearest MRT/LRT", d, ~nearest_distance_to_mrt),
filter_checkbox("storey", "Storey", d, ~storey, inline = TRUE))
# plotting interactive scatter plot using plotly
p <- plot_ly(data=d,
type= "scatter",
mode= "markers",
x= ~lease_commence_date,
y= ~resale_price,
color= ~storey,
colors= "Accent",
marker= list(size=5, opacity = 0.5,
line=list(width=0.2, color="black")),
text= ~paste("Town:",town,
"\nYear:",lease_commence_date,
"\nLocation:",address,
"\nType:",flat_type,
"\nResale Price:",prettyNum(resale_price,big.mark=","),
"\nStorey:",storey_range,
"\nNearest MRT:",nearest_mrt," ~",nearest_distance_to_mrt,"km"
)) %>%
layout(title = list(text="<b>Resale Price vs Lease Commencement Year, Singapore 2022</b>"),
hoverlabel = list(align = "left"),
legend = list(orientation = "h", y = 1, x = 0),
xaxis = list(title="Lease Commencement Year"),
yaxis = list(title="Resale Price (S$)"))
gg <- highlight(p, "plotly_selected")
# Using crosstalk bscols to put all 3 elements (filter, scatter plot, datatable) together.
crosstalk::bscols(filter_tools,gg,DT::datatable(d, class= "display",
filter=list(position="top", clear=FALSE),
options=list(pageLength = 10,scrollY = TRUE,
iDisplayLength = 25),
),
widths = c(3,9,12),
annotations = list(caption = "Data from Data.gov.sg"))On 30 Sept 2022, Singapore government implemented cooling measure with the aim to moderate the heated residential property market and ensure housing affordability. In this section, we want to find out if the cooling measure did achieve it’s stated objective.
# Computing the count and avg price per sqm
hdb_month <- hdb_data_all %>%
group_by (month, flat_type) %>%
summarise(mean_price_per_sqm = round(mean(price_sqm),0), trsn_number = n())
# Plotting the chart
p5 <- ggplot(hdb_month,aes(x=month, y=trsn_number, fill=flat_type))+
geom_bar_interactive(stat="identity", aes(data_id=month, tooltip=paste(
"Number of Transactions =",format(trsn_number,big.mark = ",", scientific = FALSE))))+
geom_text(aes(label=trsn_number),vjust=1.5, size=2.5, color = "white")+
geom_point_interactive(aes(x=month,y=mean_price_per_sqm/10,data_id=month,
tooltip=paste(
"Avg. price per sqm =",format(mean_price_per_sqm,big.mark = ",", scientific = FALSE))),
stat="identity",color="red", size=2)+
geom_vline_interactive(xintercept="2022-10",lwd=0.5,colour="grey55",linetype="dashed",
tooltip="Cooling Measure from 30 Sep 2022",
show.legend = TRUE) +
annotate("text",x="2022-10",y=20,label="Cooling Measure", size=3, angle=90, hjust=0)+
theme_linedraw() + xlab("Month") +
scale_y_continuous(name = "No. of\nTransactions",
sec.axis=sec_axis(trans=~.*10,name="Avg.\nResale Price\nper Sqm")) +
ggtitle("Number of Resale Transactions & Average Resale Price per Sqm by Month")+
theme(axis.title.y = element_text(angle=0, hjust=1),
axis.title.y.right = element_text(angle=0, vjust=1, hjust=0),
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=0.5),
axis.ticks.x = element_blank(),
panel.grid.minor.y = element_line(colour = "grey85", linetype = "dotted"),
panel.grid.major.x = element_blank(),
plot.title = element_text(size=12, face = "bold", hjust=0.5),
axis.title = element_text(size =9),
legend.position = "none") +
facet_wrap(~flat_type)
girafe(
ggobj=p5,
width_svg = 8,
height_svg = 7*0.618,
options = list(
opts_hover_inv(css = "opacity:0.3;"),
opts_hover(css = "none"),
opts_tooltip(css = tooltip_css)
)
)